home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / ICONMIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  1.8 KB  |  77 lines
  1. { iconmin.pas -- Attach "minimize" icon to application }
  2.  
  3. program IconMin;
  4.  
  5. {$R iconmin.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects;
  8.  
  9. const
  10.  
  11.   id_Icon = 'APPICON';   { Menu resource ID name }
  12.  
  13. type
  14.  
  15.   MinApplication = object(TApplication)
  16.     procedure InitMainWindow; virtual;
  17.   end;
  18.  
  19.   PMinWindow = ^MinWindow;
  20.   MinWindow = object(TWindow)
  21.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  22.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  23.       virtual;
  24.   end;
  25.  
  26.  
  27. { MinApplication }
  28.  
  29. {- Initialize MinApplication object's window }
  30. procedure MinApplication.InitMainWindow;
  31. begin
  32.   MainWindow := New(PMinWindow, Init(nil, 'IconMin'))
  33. end;
  34.  
  35.  
  36. { MinWindow }
  37.  
  38. {- Modify window class to use custom icon }
  39. procedure MinWindow.GetWindowClass(var AWndClass: TWndClass);
  40. begin
  41.   TWindow.GetWindowClass(AWndClass);
  42.   AWndClass.HIcon := LoadIcon(HInstance, id_Icon)
  43. end;
  44.  
  45. {- Display program's icon in window }
  46. procedure MinWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  47. var
  48.   IconBits, OldBitmap: HBitmap;
  49.   MemDC: HDC;
  50. begin
  51.   DrawIcon(PaintDC, 20, 20, LoadIcon(HInstance, id_Icon));
  52.   IconBits := CreateCompatibleBitmap(PaintDC, 32, 32);
  53.   MemDC := CreateCompatibleDC(PaintDC);
  54.   OldBitmap := SelectObject(MemDC, IconBits);
  55.   BitBlt(MemDC, 0, 0, 32, 32, PaintDC, 20, 20, srcCopy);
  56.   StretchBlt(PaintDC, 75, 20, 32 * 4, 32 * 4, MemDC, 0, 0, 32, 32, srcCopy);
  57.   SelectObject(MemDC, OldBitmap);
  58.   DeleteObject(OldBitmap);
  59.   DeleteDC(MemDC)
  60. end;
  61.  
  62. var
  63.  
  64.   MinApp: MinApplication;
  65.  
  66. begin
  67.   MinApp.Init('MinApp');
  68.   MinApp.Run;
  69.   MinApp.Done
  70. end.
  71.  
  72.  
  73. {--------------------------------------------------------------
  74.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  75.   Revision 1.00    Date: 3/25/1991
  76. ---------------------------------------------------------------}
  77.